home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 001_100 / disk0048 / forth.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  4.0 KB  |  239 lines
  1. 10  REM **********BASIC FORTH V. 3 ************
  2. 11  ' by C. H. Ting
  3. 12  ' PO BOX 504, Sunnyvale, CA 94086
  4. 13  ' converted to IBM PC by Art Bevilacqua, 14 Arthur St. Danvers, Ma 01923
  5. 14  ' See Dr. Dobbs Journal Number 60, October 1981 for the base article
  6. 20  DIM S(40),R(20),L(10),LO(10)
  7. 30  DIM I$(80)
  8. 40  PRINT "BASIC FORTH VERSION V.3"
  9. 50  REM N IS SP, M IS RP, K IS IP, AND L IS W.
  10. 60  ON ERROR GOTO 90
  11. 70  ON KEY(1) GOSUB 2340
  12. 80  GOTO 100
  13. 90  PRINT A$," ?"
  14. 100  M=0
  15. 110  N=0
  16. 120  REM ************ TEXT INTERPRETER  ************
  17. 130  K=1
  18. 140  INPUT I$
  19. 150  L1=0
  20. 160  L(K)=L1
  21. 170  LO(K)=LEN(I$)
  22. 180  L1=LO(K)
  23. 190  IF N<0 THEN GOTO 210
  24. 200  GOTO 230
  25. 210  PRINT "STACK EMPTY"
  26. 220  GOTO 100
  27. 230  L(K)=L(K)+1
  28. 240  IF L(K)>LO(K) THEN GOTO 350
  29. 250  B$=MID$(I$,L(K),1)
  30. 260  IF B$=" " THEN GOTO 230
  31. 270  A$=B$
  32. 280  L(K)=L(K)+1
  33. 290  IF L(K)>LO(K) THEN GOTO 340
  34. 300  B$=MID$(I$,L(K),1)
  35. 310  IF B$=" " THEN GOTO 340
  36. 320  A$=A$+B$
  37. 330  GOTO 280
  38. 340  GOTO 400
  39. 350  IF K<2 THEN GOTO 130
  40. 360  K=K-1
  41. 370  I$=MID$(I$,1,LO(K))
  42. 380  L1=LO(K)
  43. 390  GOTO 230
  44. 400  REM ***********  DICTIONARY **********
  45. 410  REM 300-900 :: HIGH LEVEL DEFINITIONS
  46. 420  IF A$<>"SQUARE" THEN GOTO 470
  47. 430  B$="DUP *"
  48. 440  I$=I$+B$
  49. 450  K=K+1
  50. 460  GOTO 160
  51. 470  IF A$<>"CUBE" THEN GOTO 520
  52. 480  B$="DUP SQUARE *"
  53. 490  I$=I$+B$
  54. 500  K=K+1
  55. 510  GOTO 160
  56. 520  IF A$<>"TEST" THEN GOTO 570
  57. 530  B$="DO PI 10 / R@ * SIN . LOOP"
  58. 540  I$=I$+B$
  59. 550  K=K+1
  60. 560  GOTO 160
  61. 570  REM
  62. 580  REM *************** LOW LEVEL DEFINITIONS NUCLEUS **********
  63. 590  IF A$<>"+" THEN GOTO 630
  64. 600  N=N-1
  65. 610  S(N)=S(N)+S(N+1)
  66. 620  GOTO 190
  67. 630  IF A$<>"-" THEN GOTO 670
  68. 640  N=N-1
  69. 650  S(N)=S(N)-S(N+1)
  70. 660  GOTO 190
  71. 670  IF A$<>"*" THEN GOTO 710
  72. 680  N=N-1
  73. 690  S(N)=S(N)*S(N+1)
  74. 700  GOTO 190
  75. 710  IF A$<>"/" THEN GOTO 750
  76. 720  N=N-1
  77. 730  S(N)=S(N)/S(N+1)
  78. 740  GOTO 190
  79. 750  IF A$<>"ABS" THEN GOTO 780
  80. 760  S(N)=ABS(S(N))
  81. 770  GOTO 190
  82. 780  IF A$<>"ATN" THEN GOTO 810
  83. 790  S(N)=ATN(S(N))
  84. 800  GOTO 190
  85. 810  IF A$<>"COS" THEN GOTO 840
  86. 820  S(N)=COS(S(N))
  87. 830  GOTO 190
  88. 840  IF A$<>"EXP" THEN GOTO 870
  89. 850  S(N)=EXP(S(N))
  90. 860  GOTO 190
  91. 870  IF A$<>"INT" THEN GOTO 900
  92. 880  S(N)=INT(S(N))
  93. 890  GOTO 190
  94. 900  IF A$<>"LOG" THEN GOTO 930
  95. 910  LET S(N)=LOG(S(N))
  96. 920  GOTO 190
  97. 930  IF A$<>"RND" THEN GOTO 960
  98. 940  S(N)=RND(-N)
  99. 950  GOTO 190
  100. 960  IF A$<>"SGN" THEN GOTO 990
  101. 970  S(N)=SGN(S(N))
  102. 980  GOTO 190
  103. 990  IF A$<>"SIN" THEN GOTO 1020
  104. 1000  S(N)=SIN(S(N))
  105. 1010  GOTO 190
  106. 1020  IF A$<>"SQR" THEN GOTO 1050
  107. 1030  S(N)=SQR(S(N))
  108. 1040  GOTO 190
  109. 1050  IF A$<>"TAN" THEN GOTO 1080
  110. 1060  S(N)=TAN(S(N))
  111. 1070  GOTO 190
  112. 1080  IF A$<>"^" THEN GOTO 1120
  113. 1090  N=N-1
  114. 1100  S(N)=S(N)^S(N+1)
  115. 1110  GOTO 190
  116. 1120  IF A$<>"S?" THEN GOTO 1170
  117. 1130  FOR I=1 TO N
  118. 1140  PRINT S(N-I+1)
  119. 1150  NEXT I
  120. 1160  GOTO 190
  121. 1170  IF A$<>"." THEN GOTO 1220
  122. 1180  IF N<1 THEN GOTO 210
  123. 1190  PRINT S(N)
  124. 1200  N=N-1
  125. 1210  GOTO 190
  126. 1220  IF A$<>"DUP" THEN GOTO 1260
  127. 1230  N=N+1
  128. 1240  S(N)=S(N-1)
  129. 1250  GOTO 190
  130. 1260  IF A$<>"DROP" THEN GOTO 1290
  131. 1270  N=N-1
  132. 1280  GOTO 190
  133. 1290  IF A$<>"SWAP" THEN GOTO 1340
  134. 1300  S(N+1)=S(N-1)
  135. 1310  S(N-1)=S(N)
  136. 1320  S(N)=S(N+1)
  137. 1330  GOTO 190
  138. 1340  IF A$<>"OVER" THEN GOTO 1380
  139. 1350  N=N+1
  140. 1360  S(N)=S(N-2)
  141. 1370  GOTO 190
  142. 1380  IF A$<>">R" THEN GOTO 1430
  143. 1390  M=M+1
  144. 1400  R(M)=S(N)
  145. 1410  N=N-1
  146. 1420  GOTO 190
  147. 1430  IF A$<>"R>" THEN GOTO 1480
  148. 1440  N=N+1
  149. 1450  S(N)=R(M)
  150. 1460  M=M-1
  151. 1470  GOTO 190
  152. 1480  IF A$<>"R@" THEN GOTO 1520
  153. 1490  N=N+1
  154. 1500  S(N)=R(M)
  155. 1510  GOTO 190
  156. 1520  REM **************CONTROL STRUCTURES **************
  157. 1530  IF A$<>"=" THEN GOTO 1600
  158. 1540  N=N-1
  159. 1550  IF S(N)=S(N+1) THEN GOTO 1580
  160. 1560  S(N)=0
  161. 1570  GOTO 190
  162. 1580  S(N)=1
  163. 1590  GOTO 190
  164. 1600  IF A$<>">" THEN GOTO 1670
  165. 1610  N=N-1
  166. 1620  IF S(N)>S(N+1) THEN GOTO 1650
  167. 1630  S(N)=0
  168. 1640  GOTO 190
  169. 1650  S(N)=1
  170. 1660  GOTO 190
  171. 1670  IF A$<>"<" THEN GOTO 1740
  172. 1680  N=N-1
  173. 1690  IF S(N)<S(N+1) THEN GOTO 1720
  174. 1700  S(N)=0
  175. 1710  GOTO 190
  176. 1720  S(N)=1
  177. 1730  GOTO 190
  178. 1740  IF A$<>"IF" THEN GOTO 1870
  179. 1750  N=N-1
  180. 1760  IF S(N+1) THEN GOTO 190
  181. 1770  FOR I=L(K) TO LO(K)-3
  182. 1780  B$=MID$(I$,I,4)
  183. 1790  IF B$="ELSE" THEN GOTO 1840
  184. 1800  IF B$="THEN" THEN GOTO 1840
  185. 1810  NEXT I
  186. 1820  PRINT "IF?"
  187. 1830  GOTO 100
  188. 1840  L(K)=I+4
  189. 1850  GOTO 190
  190. 1860  GOTO 190
  191. 1870  IF A$<>"ELSE" THEN GOTO 1890
  192. 1880  GOTO 1770
  193. 1890  IF A$<>"THEN" THEN GOTO 1910
  194. 1900  GOTO 190
  195. 1910  IF A$<>"BEGIN" THEN GOTO 1950
  196. 1920  M=M+1
  197. 1930  R(M)=L(K)
  198. 1940  GOTO 190
  199. 1950  IF A$<>"UNTIL" THEN GOTO 2030
  200. 1960  N=N-1
  201. 1970  IF S(N+1) THEN GOTO 2010
  202. 1980  IF S(N+1) THEN GOTO 190
  203. 1990  L(K)=R(M)
  204. 2000  GOTO 190
  205. 2010  M=M-1
  206. 2020  GOTO 190
  207. 2030  IF A$<>"DO" THEN GOTO 2120
  208. 2040  M=M+1
  209. 2050  R(M)=L(K)
  210. 2060  M=M+1
  211. 2070  R(M)=S(N-1)
  212. 2080  M=M+1
  213. 2090  R(M)=S(N)
  214. 2100  N=N-2
  215. 2110  GOTO 190
  216. 2120  IF A$<>"LOOP" THEN GOTO 2190
  217. 2130  R(M)=R(M)+1
  218. 2140  IF R(M-1)>R(M) THEN GOTO 2170
  219. 2150  M=M-3
  220. 2160  GOTO 190
  221. 2170  L(K)=R(M-2)
  222. 2180  GOTO 190
  223. 2190  REM ********* CONSTANTS **************
  224. 2200  IF A$<>"PI" THEN GOTO 2240
  225. 2210  N=N+1
  226. 2220  S(N)=3.14159
  227. 2230  GOTO 190
  228. 2240  IF A$<>"0" THEN GOTO 2280
  229. 2250  N=N+1
  230. 2260  S(N)=0
  231. 2270  GOTO 190
  232. 2280  IF A$<>"STOP" THEN GOTO 2300
  233. 2290  STOP
  234. 2300  REM ********* NUMBER **********
  235. 2310  N=N+1
  236. 2320  S(N)=VAL(A$)
  237. 2330  GOTO 190
  238. 2340  END
  239.